home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Tools & Utilities
/
Collection of Tools and Utilities.iso
/
print
/
isigns50.zip
/
ASK.PAS
next >
Wrap
Pascal/Delphi Source File
|
1989-10-01
|
16KB
|
447 lines
PROCEDURE ask_t; {f/sign format}
VAR char_ans : CHAR; {used for single char inut}
BEGIN
WRITELN('One can change to type of sign to format the output horizontally');
WRITELN('across page (sign) or vertically down page (banner). Do you want');
WRITE('a Sign or Banner? (S/B) -> ');
highvideo; char_ans := READKEY;
CASE char_ans OF
'B','b' : sign_type := banner;
'S','s' : sign_type := sign
END; {case}
disp_t;
avail_space
END; {procedure ask_t}
PROCEDURE ask_b; {f/block type}
VAR char_ans : CHAR; {used for single char inut}
siz_ans : STRING[3]; {used for number input}
num,err : INTEGER;
BEGIN
WRITELN('The graphic characters may be made of the letter of the character');
WRITELN('itself, two different type of blocks, or Graphic bits. Do you want to print');
WRITE('Single-strike Blocks, Overstrike blocks, Letters, or Bits? (S/O/L/B) -> ');
highvideo; char_ans := READKEY;
CASE char_ans OF
'S','s' : BEGIN
block_type := block;
GOTORC(22,1); CLREOL; lowvideo;
WRITE('Enter decimal number of character to use ->'); highvideo;
READLN(siz_ans);
IF siz_ans <> '' THEN BEGIN
VAL(siz_ans,num,err);
block_char := CHR(num)
END
END;
'L','l' : block_type := letter;
'O','o' : block_type := overstrike;
'B','b' : IF output_device <> printr THEN BEGIN
WRITELN;
WRITE('Bits aren''t available for this output device');
sak
END ELSE
block_type := bit;
END; {case}
disp_b;
disp_d;
disp_p;
disp_l;
disp_v;
avail_space;
END; {procedure_ask_b}
PROCEDURE ask_f; {f/font file}
VAR strng_ans1,strng_ans2 : S14; {used for filename input}
ok : BOOLEAN;
BEGIN
ok := TRUE;
WRITELN('The HP-LaserJet compatible soft font file and associated MkFntNfx-created');
WRITELN('index defines all characters. The default extension for the HP font is .FNT');
WRITELN('and .FNX for the index. The index filename must match the HP font filename');
WRITE('Enter FileName of HP Font File -> ');
highvideo; READLN(strng_ans1);
IF POS('.',strng_ans1) <> 0 THEN
strng_ans2 := COPY(strng_ans1,1,POS('.',strng_ans1)-1)
ELSE
strng_ans2 := strng_ans1;
init_ff(strng_ans1,strng_ans2,ok);
disp_fs;
disp_f
END; {procedure ask_f}
PROCEDURE ask_w; {f/width multiplier}
VAR err : INTEGER; {err code from strng-to-num convert}
siz_ans : STRING[3]; {used for number input}
BEGIN
WRITELN('One can make the letters of the sign or banner bigger in width');
WRITELN('by entering a multiplier. 2 doubles size, 3 triples, etc.');
WRITE('Enter multiplier for width -> ');
highvideo; READLN(siz_ans);
IF siz_ans <> '' THEN VAL(siz_ans,mult_w,err);
disp_w
END; {procedure ask_w}
PROCEDURE ask_h; {f/height multiplier}
VAR err : INTEGER; {err code from strng-to-num convert}
siz_ans : STRING[3]; {used for number input}
BEGIN
WRITELN('One can make the letters of the sign or banner bigger in height');
WRITELN('by entering a multiplier. 2 doubles size, 3 triples, etc.');
WRITE('Enter multiplier for height -> ');
highvideo; READLN(siz_ans);
IF siz_ans <> '' THEN VAL(siz_ans,mult_h,err);
disp_h
END; {procedure ask_h}
PROCEDURE ask_v; {f/inverse video}
VAR char_ans : CHAR; {used for single char inut}
BEGIN
WRITELN('This option reverses spaces to characters and vice-versa, effectively');
WRITELN('changing the output to reverse video. The background is the defined single');
WRITE('block character. Do you want Reverse Video output? (Y/N) -> ');
highvideo; char_ans := READKEY;
CASE char_ans OF
'N','n' : inv_video := FALSE;
'Y','y' : inv_video := TRUE
END; {case}
disp_v
END; {procedure ask_v}
PROCEDURE ask_a; {f/auto-centering}
VAR char_ans : CHAR; {used for single char inut}
BEGIN
WRITELN('This option is active only if the given left margin is zero.');
WRITELN('Output can be centered within the maximum output width.');
WRITE('Should output be automatically centered? (Y/N) -> ');
highvideo; char_ans := READKEY;
CASE char_ans OF
'N','n' : centering := FALSE;
'Y','y' : centering := TRUE
END; {case}
disp_a
END; {procedure ask_a}
PROCEDURE ask_m; {f/given left margin}
VAR err : INTEGER; {err code from strng-to-num convert}
siz_ans : STRING[3]; {used for number input}
BEGIN
WRITELN('One can enter a given left margin to position banners and signs');
WRITELN('on the paper. If the given left margin is zero, automatic centering');
WRITE('can also be done. Enter number for left margin -> ');
highvideo; READLN(siz_ans);
IF siz_ans <> '' THEN BEGIN
VAL(siz_ans,given_offset,err);
centering := FALSE
END;
disp_a;
disp_m
END; {procedure ask_m}
PROCEDURE ask_g; {f/given device size}
VAR err : INTEGER; {err code from strng-to-num convert}
siz_ans : STRING[3]; {used for number input}
BEGIN
WRITELN('If this option is non-zero it will override any of the other');
WRITELN('output size commands. One can enter a defined output device');
WRITE('size (max=',Max_Length,') which will be used for checks and centering -> ');
highvideo; READLN(siz_ans);
IF siz_ans <> '' THEN VAL(siz_ans,given_width,err);
avail_space;
disp_g
END; {procedure ask_g}
PROCEDURE ask_q; {f/abort exit}
VAR ans : CHAR;
BEGIN
WRITE('Do you want to abort ''SIGNS'' and quit? (Y/N) -> '^G);
highvideo; ans := READKEY;
IF ans IN ['y','Y'] THEN BEGIN
GOTORC(24,1);
WRITELN('aborting SIGNS ...');
HALT
END
END; {procedure ask_q}
PROCEDURE ask_x(VAR all_ok,font_f_open,out_f_open : BOOLEAN;
old_ff,old_of : S14); {f/exiting to input}
LABEL quick_exit;
VAR err : INTEGER; {for results of VAL procedure}
temp1,temp2 : s14; {temporary, for type conversion STRING[14] = S14}
BEGIN
all_ok := TRUE;
temp1 := font_fn; temp2 := font_fni;
IF NOT ff_open OR (old_ff <> font_fn) THEN init_ff(temp1,temp2,all_ok);
{open font file if not open or if changed}
IF sign_type = Banner THEN BEGIN
space_needed := (ndx_array[0].height * mult_h) + given_offset;
IF space_needed > avail_width THEN BEGIN
GOTORC(24,1); WRITE('Warning: Banner is too tall to fit across the output page!'^G);
sak;
END
END ELSE
space_needed := given_offset;
GOTORC(17,25); CLREOL; highvideo; WRITE(space_needed);
IF input_device = text_file THEN BEGIN {open input file}
ASSIGN(in_file,in_fn);
{$I-} RESET(in_file); {$I+}
err := IORESULT;
IF err <> 0 THEN BEGIN
in_fn := '????';
GOTORC(24,1); highvideo;
WRITELN('ERR:',err,' opening Input file, check it!'^G);
sak;
all_ok := FALSE;
GOTO quick_exit
END {if bad open}
END; {if input from file}
IF out_f_open AND (output_device <> recd_file) THEN BEGIN
{if output is open and no needed, close old it}
{$I-} CLOSE(out_file); {$I+} {close old file}
err := IORESULT;
IF err <> 0 THEN BEGIN
out_fn := '????';
GOTORC(24,1); highvideo;
WRITELN('ERR:',err,' closing output file, check it!'^G);
sak;
all_ok := FALSE;
GOTO quick_exit
END
END; {if no more file output}
IF output_device = recd_file THEN BEGIN
IF NOT out_f_